ANÁLISE ESTATÍSTICA MULTIVARIADA

Autor

João Ricardo F. de Lima

Data de Publicação

9 de março de 2024


Análise Fatorial

Análise Fatorial é uma técnica estatística para redução de dados. Ela reduz o número de variáveis (p) na análise, descrevendo combinações lineares destas (fatores) que contém a maior parte das informações das variáveis originais e que possam ter interpretações significativas. Estes fatores não são correlacionados entre si.

O “fator” é uma variável latente (não observada) que representa uma característica marcante dos dados. O objetivo da Análise Fatorial é identificar os r<p fatores e relacioná-los com as variáveis originais.

Segundo Mingoti (2005, p. 99), “a análise fatorial tem como objetivo principal descrever a variabilidade original do vetor de variáveis X, em termos de um número menor r de variáveis aleatórias, chamadas de fatores comuns e que estão relacionadas com o vetor original X através de um modelo linear. Neste modelo, parte da variabilidade de X é atribuída aos fatores comuns, sendo o restante da variabilidade de X atribuído às variáveis que não foram incluídas no modelo, ou seja, ao erro aleatório”.

Existem dois enfoques diferentes para Análise Fatorial: A Análise Fatorial Exploratória e a Análise Fatorial Confirmatória. A Análise Fatorial Exploratória objetiva determinar dimensões latentes dos dados denominadas fatores partindo-se de um conjunto de variáveis e a solução conduz a uma relação de todas as variáveis com todos os fatores. Na Análise Fatorial Confirmatória parte-se de um conjunto de variáveis e de um conjunto de hipóteses sobre o número de fatores e sobre quais variáveis se relacionam com quais fatores. O objetivo da análise é “confirmar” se as variáveis formam os fatores da forma como foi assumido. A formulação do modelo é baseada em uma teoria que será testada com a análise. O modelo especifica quais variáveis são relacionadas com quais fatores e se os fatores são correlacionados. A definição dos fatores é feita antes do ajustamento do modelo.

Seja \(\mathbf{x}\) um vetor aleatório \(p_x1\) com média \(\mathbf{\mu}\) e matriz de variância-covariância dada por \(\mathbf{\Sigma}\). A variância total de cada variável pode ser separada em três parcelas: fatores comuns (influenciam duas ou mais variáveis), fatores específicos (contribuem para a variação de uma única variável) e um erro.

Assim, a variação total vai ser a soma da variação comum (comunalidade), da variação específica (unicidade) e do erro.

\[ \mathbf{x}=\mathbf{\Lambda} \mathbf{f}+ \mathbf{\epsilon} \]

onde \(\mathbf{f}\) é um vetor aleatório de ordem \(k_x1\)(\(k<p\)), com os elementos \(f_1, \dots, f_k\) sendo denominados fatores comuns (comunalidade); \(\Lambda\) é uma matriz de constantes desconhecidas \(p_xk\) chamadas de cargas fatoriais (ou coeficientes de correlação entre as variáveis e os fatores quando as variáveis são padronizadas); e os elementos \(\epsilon_1, \dots, \epsilon_p\) do \(p_x1\) vetor aleatório \(\mathbf{\epsilon}\) são chamados de fatores específicos (unicidade) e erro. Assume-se que \(\mathbf{f}\) e \(\mathbf{\epsilon}\) não são correlacionados.

\[\begin{cases} X_1=a_{11}F_1+a_{12}F_2+a_{13}F_3+ \dots +a_{1r}F_r+\epsilon_1 \\ X_2=a_{21}F_1+a_{22}F_2+a_{23}F_3+ \dots +a_{2r}F_r+\epsilon_2 \\ X_3=a_{31}F_1+a_{32}F_2+a_{33}F_3+ \dots +a_{3r}F_r+\epsilon_3 \\ . \\ . \\ . \\ X_p=a_{p1}F_1+a_{p2}F_2+a_{p3}F_3+ \dots +a_{pr}F_r+\epsilon_p \\ \end{cases}\]

O modelo tem como objetivo explicar o comportamento das p variáveis em função de r<p fatores comuns (desconhecidos) e de um termo de erro composto de unicidade (fatores específicos) e erro aleatório. O processo de estimação consiste em determinar a matriz de cargas fatoriais \(\mathbf{\Lambda}\).

Pressupostos do Modelo de Análise Fatorial

Os pressupostos do Modelo de Análise Fatorial podem ser resumidos em:

  1. \(\mathbf{f} \sim (\mathbf{0},\mathbf{I})\), ou seja, os fatores possuem média zero e variância constante igual a um e não são autocorrelacionados;

  2. \(\epsilon \sim (\mathbf{0},\mathbf{\Psi})\), em que \(\mathbf{\Psi}=diag(\psi_1,\dots,\psi_p)\), ou seja, os erros tem média zero e podem ter variâncias diferentes, mas não correlacionadas;

  3. \(\mathbf{f}\) e \(\mathbf{\epsilon}\) são independentes, ou seja, os fatores comuns são independentes dos fatores específicos e erros.

A Análise Fatorial pode ser feita com a matriz de variâncias e covariâncias ou com a matriz de correlações. Como normalmente é recomendado o uso de variáveis padronizadas para contornar o problema de unidades de medidas diferentes e a influência que uma variável com variância grande pode ter na determinação das cargas fatoriais, a Análise Fatorial é, quase sempre, feita com a matriz de correlações \(\mathbf{\Sigma}\) .

No modelo fatorial, a matriz \(\mathbf{\Sigma}\) é decomposta como

\[ \mathbf{\Sigma}=E(xx') \]

\[ \mathbf{\Sigma}=E[(\mathbf{\Lambda} \mathbf{f}+ \mathbf{\epsilon})(\mathbf{\Lambda} \mathbf{f}+ \mathbf{\epsilon})'] \]

sendo que é possível demonstrar que o resultado desta decomposição é

\[ \mathbf{\Sigma}=\mathbf{\Lambda}\mathbf{\Phi}\mathbf{\Lambda}'+\mathbf{\Psi} \] Este resultado, que é derivado com base nas pressuposições do modelo, diz que a matriz de correlações pode ser decomposta em duas parcelas, uma relacionada com a comunalidade e outra com a unicidade. O modelo assume que os fatores não são correlacionados \(\mathbf{\Phi}=\mathbf{I}\).

Um termo importante na Análise Fatorial é a comunalidade, ou seja, o somatório das correlações dos fatores com a variável “i”.

\[ \mathbf{h_i^2}=a_{i1}^2+a_{i2}^2+\dots+a_{ir}^2 \]

A Unicidade (\(\mathbf{\Psi}\)) é dada por \(\mathbf{\Psi}=1-\mathbf{h_i^2}\).

A comunalidade é a parcela da variância de X explicada pelos r fatores e a unicidade é a parcela não explicada.

Estimação das Cargas Fatoriais

Dado o modelo

\[ \mathbf{x}=\mathbf{\Lambda} \mathbf{f}+ \mathbf{\epsilon} \] pode-se entender o x como a variável dependente e o f como as variáveis explicativas, \(\Lambda\) como como os coefientes e \(\epsilon\) como os erros de um modelo de regressão múltipla.

O problema, então, é estimar \(\mathbf{\Lambda}\) e \(\mathbf{\Psi}\) que reproduzam \(\mathbf{\Sigma}\) com um número de fatores r menor que o número de variáveis originais p, mas apenas o x é conhecido.

Existem diversas formas de estimar as cargas fatoriais sendo que componentes principais e máxima verossimilhança são as principais. As explicações mais detalhadas podem ser encontradas em Mingoti (2005).

O método dos Componentes Principais é o mais usado e tem como base o uso das raízes características e vetores característicos relacionados com r<p componentes para estimar \(\Lambda\). O método de Máxima Verossimilhança maximiza uma função de verossimilhança formada com a pressuposição de que o vetor de variáveis aleatórias X segue distribuição normal p-variada com vetor de médias \(\mu\) e matriz de variâncias e covariâncias \(\mathbf{\Sigma}\).

O método dos componentes principais parte da decomposição espectral da matriz de variâncias e covariâncias \(\mathbf{\Sigma}\). Assim, é necessário informar que a decomposição espectral de uma matriz é uma operação que relaciona a matriz com seus autovalores e seus autovetores.

Considere A uma matriz \(p_xp\) simétrica com raízes características \(\lambda_p\) e vetores característicos \(x_p\). A decomposição espectral de A é dada por

\[ A=\sum \lambda_i x_i x_i' \] com i variando de 1 a p. A decomposição pode ser representada por \(A=P \Lambda P'\) em que P é uma matriz cujas colunas são os vetores característicos normalizados de A e \(\Lambda\) é uma matriz diagonal com as raízes características de A na diagonal principal. Dessa relação tem-se, também, que \(\Lambda=PAP'\) que é uma operação denominada diagonalização de A.

Pelo teorema da decomposição espectral, a matriz de correlação amostral ou a matriz de variâncias e covariâncias pode ser decomposta como a soma de p matrizes, cada uma relacionada com um autovetor da matriz \(\mathbf{\Sigma}\).

\[ \Sigma=P \Lambda P'=\sum \lambda_i x_i x_i' \] com i variando de 1 a p. Com p componentes, a matriz \(\mathbf{\Sigma}\) é totalmente reproduzida. Para r < p, pode-se escrever

\[ \Sigma=P \Lambda P'=\sum_{j=1}^r \lambda_j x_j x_j' + \sum_{j=r+1}^p \lambda_j x_j x_j' \]

Cada parcela desta soma envolve uma matriz de dimensão \(p_xp\) correspondente a informação da j-ésima componente fazendo com que a variabilidade das variáveis seja representada pela soma da variabilidade relacionada com cada componente. Assim, pode-se escrever

\[ \Sigma=\sum_{j=1}^r \lambda_j x_j x_j' + \sum_{j=r+1}^p \lambda_j x_j x_j'=P_1 \Lambda_1 P_1'+P_2 \Lambda_2 P_2' \] e pode-se considerar uma aproximação da matriz de correlações \(\mathbf{\Sigma}\) dada por

\[ \mathbf{\Sigma} \approx P_1 \Lambda_1 P_1'=\sum_{j=1}^r \lambda_j x_j x_j' \] o que possibilita estimar as matrizes \(\Lambda\) e \(\Psi\) por meio de raízes e vetores característicos de \(\mathbf{\Sigma}\).

Pela decomposição espectral ainda é possível escrever

\[ \mathbf{\Sigma} \approx P_1 \Lambda_1^{1/2} \Lambda_1^{1/2}P_1' \] e definir por \(A=P_1 \Lambda_1^{1/2}\) e por \(A'=\Lambda_1^{1/2}P_1'\)

Esta aproximação de \(\mathbf{\Sigma}\) considera que os fatores específicos são de menor importância. Incluindo os fatores específicos a aproximação de \(\mathbf{\Sigma}\) fica

\[ \mathbf{\Sigma} \approx AA' + \Psi \] e a matriz \(\Psi\), que é diagonal, pode ser estimada por

\[ \Psi = diag(R-AA') \]

A matriz de resíduos resultante do ajustamento do modelo é definida por

\[ RES= \mathbf{\Sigma} - (AA'+\Psi) \]

que serve como critério de avaliação do modelo. Valores pequenos, próximos de zero, indicam bom ajustamento. Esta matriz só é nula quando todos os “p” fatores são extraídos, o que não é o desejado na prática. Através destes procedimentos os elementos da diagonal da matriz \(\mathbf{\Sigma}\) (variâncias) são exatamente reproduzidos por \(AA'+\Psi\). Entretanto, o mesmo não ocorre para os elementos fora da diagonal principal (correlações).

Todo o conhecimento de Componentes Principais se aplica neste caso com os componentes agora denominados fatores.

Demonstração de Análise Fatorial no R por Componentes Principais

#Direcionado o R para o Diretorio a ser trabalhado
setwd('/Users/jricardofl/Dropbox/tempecon/multivariada')

library(tidyverse)
library(skimr)
library(psych)
library(REdaS)

#Lendo os dados no R
dados <- read.csv2('winequality-red.csv', sep=";", dec=".")
dados <- dados |> 
  dplyr::select(-quality) #retira a variável quality

attach(dados)
glimpse(dados)
Rows: 1,599
Columns: 11
$ fixed.acidity        <dbl> 7.4, 7.8, 7.8, 11.2, 7.4, 7.4, 7.9, 7.3, 7.8, 7.5…
$ volatile.acidity     <dbl> 0.700, 0.880, 0.760, 0.280, 0.700, 0.660, 0.600, …
$ citric.acid          <dbl> 0.00, 0.00, 0.04, 0.56, 0.00, 0.00, 0.06, 0.00, 0…
$ residual.sugar       <dbl> 1.9, 2.6, 2.3, 1.9, 1.9, 1.8, 1.6, 1.2, 2.0, 6.1,…
$ chlorides            <dbl> 0.076, 0.098, 0.092, 0.075, 0.076, 0.075, 0.069, …
$ free.sulfur.dioxide  <dbl> 11, 25, 15, 17, 11, 13, 15, 15, 9, 17, 15, 17, 16…
$ total.sulfur.dioxide <dbl> 34, 67, 54, 60, 34, 40, 59, 21, 18, 102, 65, 102,…
$ density              <dbl> 0.9978, 0.9968, 0.9970, 0.9980, 0.9978, 0.9978, 0…
$ pH                   <dbl> 3.51, 3.20, 3.26, 3.16, 3.51, 3.51, 3.30, 3.39, 3…
$ sulphates            <dbl> 0.56, 0.68, 0.65, 0.58, 0.56, 0.56, 0.46, 0.47, 0…
$ alcohol              <dbl> 9.4, 9.8, 9.8, 9.8, 9.4, 9.4, 9.4, 10.0, 9.5, 10.…
head(dados)
tail(dados)
# Estatística descritiva das variáveis
summary(dados)
 fixed.acidity   volatile.acidity  citric.acid    residual.sugar  
 Min.   : 4.60   Min.   :0.1200   Min.   :0.000   Min.   : 0.900  
 1st Qu.: 7.10   1st Qu.:0.3900   1st Qu.:0.090   1st Qu.: 1.900  
 Median : 7.90   Median :0.5200   Median :0.260   Median : 2.200  
 Mean   : 8.32   Mean   :0.5278   Mean   :0.271   Mean   : 2.539  
 3rd Qu.: 9.20   3rd Qu.:0.6400   3rd Qu.:0.420   3rd Qu.: 2.600  
 Max.   :15.90   Max.   :1.5800   Max.   :1.000   Max.   :15.500  
   chlorides       free.sulfur.dioxide total.sulfur.dioxide    density      
 Min.   :0.01200   Min.   : 1.00       Min.   :  6.00       Min.   :0.9901  
 1st Qu.:0.07000   1st Qu.: 7.00       1st Qu.: 22.00       1st Qu.:0.9956  
 Median :0.07900   Median :14.00       Median : 38.00       Median :0.9968  
 Mean   :0.08747   Mean   :15.87       Mean   : 46.47       Mean   :0.9967  
 3rd Qu.:0.09000   3rd Qu.:21.00       3rd Qu.: 62.00       3rd Qu.:0.9978  
 Max.   :0.61100   Max.   :72.00       Max.   :289.00       Max.   :1.0037  
       pH          sulphates         alcohol     
 Min.   :2.740   Min.   :0.3300   Min.   : 8.40  
 1st Qu.:3.210   1st Qu.:0.5500   1st Qu.: 9.50  
 Median :3.310   Median :0.6200   Median :10.20  
 Mean   :3.311   Mean   :0.6581   Mean   :10.42  
 3rd Qu.:3.400   3rd Qu.:0.7300   3rd Qu.:11.10  
 Max.   :4.010   Max.   :2.0000   Max.   :14.90  
skim(dados)
Data summary
Name dados
Number of rows 1599
Number of columns 11
_______________________
Column type frequency:
numeric 11
________________________
Group variables None

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
fixed.acidity 0 1 8.32 1.74 4.60 7.10 7.90 9.20 15.90 ▂▇▂▁▁
volatile.acidity 0 1 0.53 0.18 0.12 0.39 0.52 0.64 1.58 ▅▇▂▁▁
citric.acid 0 1 0.27 0.19 0.00 0.09 0.26 0.42 1.00 ▇▆▅▁▁
residual.sugar 0 1 2.54 1.41 0.90 1.90 2.20 2.60 15.50 ▇▁▁▁▁
chlorides 0 1 0.09 0.05 0.01 0.07 0.08 0.09 0.61 ▇▁▁▁▁
free.sulfur.dioxide 0 1 15.87 10.46 1.00 7.00 14.00 21.00 72.00 ▇▅▁▁▁
total.sulfur.dioxide 0 1 46.47 32.90 6.00 22.00 38.00 62.00 289.00 ▇▂▁▁▁
density 0 1 1.00 0.00 0.99 1.00 1.00 1.00 1.00 ▁▃▇▂▁
pH 0 1 3.31 0.15 2.74 3.21 3.31 3.40 4.01 ▁▅▇▂▁
sulphates 0 1 0.66 0.17 0.33 0.55 0.62 0.73 2.00 ▇▅▁▁▁
alcohol 0 1 10.42 1.07 8.40 9.50 10.20 11.10 14.90 ▇▇▃▁▁

O banco de dados é composto por 1599 observações e 12 variáveis: acidez fixa, acidez volátil, ácido cítrico, açucar residual, cloretos, dióxido de enxofre livre, dióxido de enxofre total, densidade, Ph, sulfatos, álcool.

library(corrplot)
corrplot(cor(dados), order="hclust", tl.col="black", tl.cex = .75)

#Obtenção do Modelo Fatorial Ortogonal

#Analise Fatorial - dados devem ser padronizados
#Padronizaçao dos dados
dados.pad <-as.data.frame(scale(dados))

s <- cov(dados.pad) #matriz de cov com var pad = mat correlaçoes origem

#Autovalores e Autovetores da Matriz de Covariancias
lambda <-eigen(s)$values
lambda #
 [1] 3.09913244 1.92590969 1.55054349 1.21323253 0.95929207 0.65960826
 [7] 0.58379122 0.42295670 0.34464212 0.18133317 0.05955831
evec <-eigen(s)$vectors
evec
             [,1]         [,2]        [,3]         [,4]        [,5]        [,6]
 [1,]  0.48931422 -0.110502738 -0.12330157 -0.229617370  0.08261366 -0.10147858
 [2,] -0.23858436  0.274930480 -0.44996253  0.078959783 -0.21873452 -0.41144893
 [3,]  0.46363166 -0.151791356  0.23824707 -0.079418256  0.05857268 -0.06959338
 [4,]  0.14610715  0.272080238  0.10128338 -0.372792562 -0.73214429 -0.04915555
 [5,]  0.21224658  0.148051555 -0.09261383  0.666194756 -0.24650090 -0.30433857
 [6,] -0.03615752  0.513566812  0.42879287 -0.043537818  0.15915198  0.01400021
 [7,]  0.02357485  0.569486959  0.32241450 -0.034577115  0.22246456 -0.13630755
 [8,]  0.39535301  0.233575490 -0.33887135 -0.174499758 -0.15707671  0.39115230
 [9,] -0.43851962  0.006710793  0.05769735 -0.003787746 -0.26752977  0.52211645
[10,]  0.24292133 -0.037553916  0.27978615  0.550872362 -0.22596222  0.38126343
[11,] -0.11323206 -0.386180959  0.47167322 -0.122181088 -0.35068141 -0.36164504
             [,7]        [,8]         [,9]       [,10]        [,11]
 [1,]  0.35022736  0.17759545 -0.194020908 -0.24952314  0.639691452
 [2,]  0.53373510  0.07877531  0.129110301  0.36592473  0.002388597
 [3,] -0.10549701  0.37751558  0.381449669  0.62167708 -0.070910304
 [4,] -0.29066341 -0.29984469 -0.007522949  0.09287208  0.184029964
 [5,] -0.37041337  0.35700936 -0.111338666 -0.21767112  0.053065322
 [6,]  0.11659611  0.20478050 -0.635405218  0.24848326 -0.051420865
 [7,]  0.09366237 -0.01903597  0.592115893 -0.37075027  0.068701598
 [8,]  0.17048116  0.23922267 -0.020718675 -0.23999012 -0.567331898
 [9,]  0.02513762  0.56139075  0.167745886 -0.01096960  0.340710903
[10,]  0.44746911 -0.37460432  0.058367062  0.11232046  0.069555381
[11,]  0.32765090  0.21762556 -0.037603106 -0.30301450 -0.314525906
evec[,1:4]
             [,1]         [,2]        [,3]         [,4]
 [1,]  0.48931422 -0.110502738 -0.12330157 -0.229617370
 [2,] -0.23858436  0.274930480 -0.44996253  0.078959783
 [3,]  0.46363166 -0.151791356  0.23824707 -0.079418256
 [4,]  0.14610715  0.272080238  0.10128338 -0.372792562
 [5,]  0.21224658  0.148051555 -0.09261383  0.666194756
 [6,] -0.03615752  0.513566812  0.42879287 -0.043537818
 [7,]  0.02357485  0.569486959  0.32241450 -0.034577115
 [8,]  0.39535301  0.233575490 -0.33887135 -0.174499758
 [9,] -0.43851962  0.006710793  0.05769735 -0.003787746
[10,]  0.24292133 -0.037553916  0.27978615  0.550872362
[11,] -0.11323206 -0.386180959  0.47167322 -0.122181088
#Matriz de Cargas Fatoriais A modelo completo
A <- sqrt(lambda)*t(evec)
A <- t(A) #Extracao dos Fatores
A[,1:4] #4 primeiros fatores
             [,1]         [,2]        [,3]         [,4]
 [1,]  0.86140602 -0.153352549 -0.15353613 -0.252916266
 [2,] -0.42001233  0.381540681 -0.56029703  0.086971702
 [3,]  0.81619353 -0.210651715  0.29666720 -0.087476695
 [4,]  0.25721219  0.377585196  0.12611890 -0.410619209
 [5,]  0.37364637  0.205461726 -0.11532350  0.733792441
 [6,] -0.06365298  0.712713376  0.53393641 -0.047955529
 [7,]  0.04150200  0.790317762  0.40147319 -0.038085598
 [8,]  0.69599339  0.324149404 -0.42196539 -0.192205961
 [9,] -0.77198543  0.009313047  0.07184521 -0.004172083
[10,]  0.42764729 -0.052116254  0.34839201  0.606768473
[11,] -0.19933772 -0.535930923  0.58733137 -0.134578602
AAT <- A%*%t(A)
AAT
             [,1]         [,2]        [,3]         [,4]         [,5]
 [1,]  1.00000000 -0.256130895  0.67170343  0.114776724  0.093705186
 [2,] -0.25613089  1.000000000 -0.55249568  0.001917882  0.061297772
 [3,]  0.67170343 -0.552495685  1.00000000  0.143577162  0.203822914
 [4,]  0.11477672  0.001917882  0.14357716  1.000000000  0.055609535
 [5,]  0.09370519  0.061297772  0.20382291  0.055609535  1.000000000
 [6,] -0.15379419 -0.010503827 -0.06097813  0.187048995  0.005562147
 [7,] -0.11318144  0.076470005  0.03553302  0.203027882  0.047400468
 [8,]  0.66804729  0.022026232  0.36494718  0.355283371  0.200632327
 [9,] -0.68297819  0.234937294 -0.54190414 -0.085652422 -0.265026131
[10,]  0.18300566 -0.260986685  0.31277004  0.005527121  0.371260481
[11,] -0.06166827 -0.202288027  0.10990325  0.042075437 -0.221140545
              [,6]        [,7]        [,8]        [,9]        [,10]       [,11]
 [1,] -0.153794193 -0.11318144  0.66804729 -0.68297819  0.183005664 -0.06166827
 [2,] -0.010503827  0.07647000  0.02202623  0.23493729 -0.260986685 -0.20228803
 [3,] -0.060978129  0.03553302  0.36494718 -0.54190414  0.312770044  0.10990325
 [4,]  0.187048995  0.20302788  0.35528337 -0.08565242  0.005527121  0.04207544
 [5,]  0.005562147  0.04740047  0.20063233 -0.26502613  0.371260481 -0.22114054
 [6,]  1.000000000  0.66766645 -0.02194583  0.07037750  0.051657572 -0.06940835
 [7,]  0.667666450  1.00000000  0.07126948 -0.06649456  0.042946836 -0.20565394
 [8,] -0.021945831  0.07126948  1.00000000 -0.34169933  0.148506412 -0.49617977
 [9,]  0.070377499 -0.06649456 -0.34169933  1.00000000 -0.196647602  0.20563251
[10,]  0.051657572  0.04294684  0.14850641 -0.19664760  1.000000000  0.09359475
[11,] -0.069408354 -0.20565394 -0.49617977  0.20563251  0.093594750  1.00000000
#Proporção da variabilidade explicada por cada componente
round(lambda/sum(lambda),4)
 [1] 0.2817 0.1751 0.1410 0.1103 0.0872 0.0600 0.0531 0.0385 0.0313 0.0165
[11] 0.0054
#Matriz de Cargas Fatoriais m =4
Am4 <- A[,1:4]
AATm4 <- Am4%*%t(Am4)
AATm4
            [,1]         [,2]        [,3]        [,4]        [,5]         [,6]
 [1,]  0.8530773 -0.356282107  0.71195314  0.24814895  0.12247144 -0.233977270
 [2,] -0.3562821  0.643480495 -0.59701330 -0.07034447  0.04989052 -0.004669574
 [3,]  0.7119531 -0.597013301  0.80620963  0.20373091  0.16328445 -0.039491036
 [4,]  0.2481489 -0.070344474  0.20373091  0.39324280 -0.14216804  0.339768628
 [5,]  0.1224714  0.049890516  0.16328445 -0.14216804  0.73357699  0.025886794
 [6,] -0.2339773 -0.004669574 -0.03949104  0.33976863  0.02588679  0.799399877
 [7,] -0.1374553  0.055850417 -0.01017259  0.37535914  0.10364091  0.776815880
 [8,]  0.6632227  0.051059853  0.39141293  0.32711765  0.23427895 -0.029361784
 [9,] -0.6763967  0.287179195 -0.61037224 -0.18427342 -0.29788297  0.094337555
[10,]  0.1694177 -0.341932930  0.41029971 -0.11489421  0.55414529  0.092556300
[11,] -0.1456638 -0.461539701  0.13621105 -0.12429753 -0.35108098 -0.049225308
              [,7]        [,8]         [,9]       [,10]       [,11]
 [1,] -0.137455339  0.66322270 -0.676396717  0.16941773 -0.14566381
 [2,]  0.055850417  0.05105985  0.287179195 -0.34193293 -0.46153970
 [3,] -0.010172594  0.39141293 -0.610372244  0.41029971  0.13621105
 [4,]  0.375359142  0.32711765 -0.184273418 -0.11489421 -0.12429753
 [5,]  0.103640907  0.23427895 -0.297882965  0.55414529 -0.35108098
 [6,]  0.776815880 -0.02936178  0.094337555  0.09255630 -0.04922531
 [7,]  0.788955815  0.12297864  0.004324146  0.09332073 -0.19090534
 [8,]  0.122978641  0.80447756 -0.563792229  0.01711234 -0.53442613
 [9,]  0.004324146 -0.56379223  0.601227370 -0.30812402  0.19165309
[10,]  0.093320730  0.01711234 -0.308124024  0.67514328  0.06564798
[11,] -0.190905338 -0.53442613  0.191653087  0.06564798  0.69002702
#Matriz PSI - Unicidade
psi <- diag(diag(s-AATm4))
psi
           [,1]      [,2]      [,3]      [,4]     [,5]      [,6]      [,7]
 [1,] 0.1469227 0.0000000 0.0000000 0.0000000 0.000000 0.0000000 0.0000000
 [2,] 0.0000000 0.3565195 0.0000000 0.0000000 0.000000 0.0000000 0.0000000
 [3,] 0.0000000 0.0000000 0.1937904 0.0000000 0.000000 0.0000000 0.0000000
 [4,] 0.0000000 0.0000000 0.0000000 0.6067572 0.000000 0.0000000 0.0000000
 [5,] 0.0000000 0.0000000 0.0000000 0.0000000 0.266423 0.0000000 0.0000000
 [6,] 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.2006001 0.0000000
 [7,] 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.0000000 0.2110442
 [8,] 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.0000000 0.0000000
 [9,] 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.0000000 0.0000000
[10,] 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.0000000 0.0000000
[11,] 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.0000000 0.0000000
           [,8]      [,9]     [,10]    [,11]
 [1,] 0.0000000 0.0000000 0.0000000 0.000000
 [2,] 0.0000000 0.0000000 0.0000000 0.000000
 [3,] 0.0000000 0.0000000 0.0000000 0.000000
 [4,] 0.0000000 0.0000000 0.0000000 0.000000
 [5,] 0.0000000 0.0000000 0.0000000 0.000000
 [6,] 0.0000000 0.0000000 0.0000000 0.000000
 [7,] 0.0000000 0.0000000 0.0000000 0.000000
 [8,] 0.1955224 0.0000000 0.0000000 0.000000
 [9,] 0.0000000 0.3987726 0.0000000 0.000000
[10,] 0.0000000 0.0000000 0.3248567 0.000000
[11,] 0.0000000 0.0000000 0.0000000 0.309973
#Matriz Residual
s-(AATm4+psi)
                     fixed.acidity volatile.acidity citric.acid residual.sugar
fixed.acidity          0.000000000      0.100151213 -0.04024971    -0.13337222
volatile.acidity       0.100151213      0.000000000  0.04451762     0.07226236
citric.acid           -0.040249708      0.044517616  0.00000000    -0.06015375
residual.sugar        -0.133372222      0.072262356 -0.06015375     0.00000000
chlorides             -0.028766250      0.011407257  0.04053846     0.19777757
free.sulfur.dioxide    0.080183077     -0.005834253 -0.02148709    -0.15271963
total.sulfur.dioxide   0.024273896      0.020619588  0.04570562    -0.17233126
density                0.004824587     -0.029033620 -0.02646575     0.02816572
pH                    -0.006581477     -0.052241900  0.06846810     0.09862100
sulphates              0.013587936      0.080946245 -0.09752967     0.12042133
alcohol                0.083995539      0.259251674 -0.02630781     0.16637297
                       chlorides free.sulfur.dioxide total.sulfur.dioxide
fixed.acidity        -0.02876625         0.080183077           0.02427390
volatile.acidity      0.01140726        -0.005834253           0.02061959
citric.acid           0.04053846        -0.021487093           0.04570562
residual.sugar        0.19777757        -0.152719633          -0.17233126
chlorides             0.00000000        -0.020324647          -0.05624044
free.sulfur.dioxide  -0.02032465         0.000000000          -0.10914943
total.sulfur.dioxide -0.05624044        -0.109149430           0.00000000
density              -0.03364662         0.007415953          -0.05170916
pH                    0.03285683        -0.023960057          -0.07081870
sulphates            -0.18288481        -0.040898728          -0.05037389
alcohol               0.12994044        -0.020183045          -0.01474861
                          density           pH   sulphates     alcohol
fixed.acidity         0.004824587 -0.006581477  0.01358794  0.08399554
volatile.acidity     -0.029033620 -0.052241900  0.08094624  0.25925167
citric.acid          -0.026465753  0.068468099 -0.09752967 -0.02630781
residual.sugar        0.028165719  0.098620996  0.12042133  0.16637297
chlorides            -0.033646623  0.032856834 -0.18288481  0.12994044
free.sulfur.dioxide   0.007415953 -0.023960057 -0.04089873 -0.02018305
total.sulfur.dioxide -0.051709165 -0.070818705 -0.05037389 -0.01474861
density               0.000000000  0.222092895  0.13139407  0.03824636
pH                    0.222092895  0.000000000  0.11147642  0.01397942
sulphates             0.131394068  0.111476421  0.00000000  0.02794677
alcohol               0.038246359  0.013979422  0.02794677  0.00000000
#2 Forma de fazer a Analise Fatorial
matcor <- cor(dados)

k <- 4
dados.pca <- prcomp(dados.pad, scale = TRUE) #PCA
carfat <- dados.pca$rotation[, 1:k] %*% diag(dados.pca$sdev[1:k])
colnames(carfat) <- paste("Fator", 1:k, sep = " ")

#Cargas Fatoriais com autovalor maior do que 1
carfat
                         Fator 1      Fator 2     Fator 3      Fator 4
fixed.acidity         0.86140602  0.153352549 -0.15353613  0.252916266
volatile.acidity     -0.42001233 -0.381540681 -0.56029703 -0.086971702
citric.acid           0.81619353  0.210651715  0.29666720  0.087476695
residual.sugar        0.25721219 -0.377585196  0.12611890  0.410619209
chlorides             0.37364637 -0.205461726 -0.11532350 -0.733792441
free.sulfur.dioxide  -0.06365298 -0.712713376  0.53393641  0.047955529
total.sulfur.dioxide  0.04150200 -0.790317762  0.40147319  0.038085598
density               0.69599339 -0.324149404 -0.42196539  0.192205961
pH                   -0.77198543 -0.009313047  0.07184521  0.004172083
sulphates             0.42764729  0.052116254  0.34839201 -0.606768473
alcohol              -0.19933772  0.535930923  0.58733137  0.134578602
#Comunalidade e Unicidade
comum <- rowSums(carfat^2)
vespec <- diag(matcor) - comum
estimat <- cbind(comum, vespec, diag(matcor))
rownames(estimat) <- colnames(dados)
colnames(estimat) <- c("Comunalidade", "Unicidade", "Variância")
estimat
                     Comunalidade Unicidade Variância
fixed.acidity           0.8530773 0.1469227         1
volatile.acidity        0.6434805 0.3565195         1
citric.acid             0.8062096 0.1937904         1
residual.sugar          0.3932428 0.6067572         1
chlorides               0.7335770 0.2664230         1
free.sulfur.dioxide     0.7993999 0.2006001         1
total.sulfur.dioxide    0.7889558 0.2110442         1
density                 0.8044776 0.1955224         1
pH                      0.6012274 0.3987726         1
sulphates               0.6751433 0.3248567         1
alcohol                 0.6900270 0.3099730         1
#Matriz de Resíduos
resid <- matcor - (carfat %*% t(carfat) + diag(vespec))
resid
                     fixed.acidity volatile.acidity citric.acid residual.sugar
fixed.acidity          0.000000000      0.100151213 -0.04024971    -0.13337222
volatile.acidity       0.100151213      0.000000000  0.04451762     0.07226236
citric.acid           -0.040249708      0.044517616  0.00000000    -0.06015375
residual.sugar        -0.133372222      0.072262356 -0.06015375     0.00000000
chlorides             -0.028766250      0.011407257  0.04053846     0.19777757
free.sulfur.dioxide    0.080183077     -0.005834253 -0.02148709    -0.15271963
total.sulfur.dioxide   0.024273896      0.020619588  0.04570562    -0.17233126
density                0.004824587     -0.029033620 -0.02646575     0.02816572
pH                    -0.006581477     -0.052241900  0.06846810     0.09862100
sulphates              0.013587936      0.080946245 -0.09752967     0.12042133
alcohol                0.083995539      0.259251674 -0.02630781     0.16637297
                       chlorides free.sulfur.dioxide total.sulfur.dioxide
fixed.acidity        -0.02876625         0.080183077           0.02427390
volatile.acidity      0.01140726        -0.005834253           0.02061959
citric.acid           0.04053846        -0.021487093           0.04570562
residual.sugar        0.19777757        -0.152719633          -0.17233126
chlorides             0.00000000        -0.020324647          -0.05624044
free.sulfur.dioxide  -0.02032465         0.000000000          -0.10914943
total.sulfur.dioxide -0.05624044        -0.109149430           0.00000000
density              -0.03364662         0.007415953          -0.05170916
pH                    0.03285683        -0.023960057          -0.07081870
sulphates            -0.18288481        -0.040898728          -0.05037389
alcohol               0.12994044        -0.020183045          -0.01474861
                          density           pH   sulphates     alcohol
fixed.acidity         0.004824587 -0.006581477  0.01358794  0.08399554
volatile.acidity     -0.029033620 -0.052241900  0.08094624  0.25925167
citric.acid          -0.026465753  0.068468099 -0.09752967 -0.02630781
residual.sugar        0.028165719  0.098620996  0.12042133  0.16637297
chlorides            -0.033646623  0.032856834 -0.18288481  0.12994044
free.sulfur.dioxide   0.007415953 -0.023960057 -0.04089873 -0.02018305
total.sulfur.dioxide -0.051709165 -0.070818705 -0.05037389 -0.01474861
density               0.000000000  0.222092895  0.13139407  0.03824636
pH                    0.222092895  0.000000000  0.11147642  0.01397942
sulphates             0.131394068  0.111476421  0.00000000  0.02794677
alcohol               0.038246359  0.013979422  0.02794677  0.00000000
# Estimativas das cargas fatoriais das variaveis 

plot(carfat, pch = 20, col = "red", xlab = "Fator 1", ylab = "Fator 2")
text(carfat, rownames(carfat), adj = 1)

Em relação a Análise Fatorial por Máxima Verossimilhança, supondo o vetor de variáveis com distribuição Normal p-variada, tem-se

  1. as variáveis padronizadas serão Z \(\sim\) N(0, \(\Sigma\));

  2. o vetor de fatores será F \(\sim\) N(0,I);

  3. o vetor de erros será \(\epsilon \sim N(0, \Psi)\)

Pelo modelo fatorial \(\mathbf{x}=\mathbf{\Lambda} \mathbf{f}+ \mathbf{\epsilon}\) e \(\mathbf{\Sigma} \approx AA' + \Psi\). Com uma amostra de n observações o objetivo é estimar \(\hat A\) e \(\hat \Psi\). O procedimento consiste em maximizar a função de verossimilhança

\[ L(0, \Sigma)=(2 \pi)^{(\frac{-np}{2})}|AA' + \Psi|^{\frac{-n}{2}}e^{\frac{-1}{2}\sum_{j=1}^n Z_j'(AA'+\Psi)^{-1}Z_j} \] É necessário definir o número de fatores antecipadamente. Uma mudança neste número acarreta mudança nas cargas fatoriais, diferentemente do método de componentes principais. Na Analise Fatorial por Máxima Verossimilhança há equivalência entre decompor \(\Sigma\) ou a matriz de covariâncias \(S\), o que não ocorre na AF via Componentes Principais.

Demonstração de Análise Fatorial no R por Máxima Verossimilhança

# Definição do número de Fatores

eigv <- eigen(cor(dados))
eigv <- data.frame(nfact = 1:ncol(dados), eigval = eigv$values)
ggplot(data = eigv, mapping = aes(nfact, eigval)) +
geom_line() +
geom_point() +
geom_abline(slope = 0, intercept = 1, color = "red") +
labs(x = "Número de fatores",
y = "Autovalor",
title = "Scree plot") +
theme_bw()

#Terceira forma de fazer - factanal()
#Usar as variaveis padronizadas - dados.pad
#Não usa componentes principais, usa max verosimilhança

#Pelo Screeplot, tem-se 4 autovalores acima de 1

fatorial1 <- factanal(dados.pad, factors=4, rotation="none", na.action=na.omit)

fatorial1

Call:
factanal(x = dados.pad, factors = 4, na.action = na.omit, rotation = "none")

Uniquenesses:
       fixed.acidity     volatile.acidity          citric.acid 
               0.101                0.789                0.401 
      residual.sugar            chlorides  free.sulfur.dioxide 
               0.701                0.921                0.454 
total.sulfur.dioxide              density                   pH 
               0.171                0.005                0.271 
           sulphates              alcohol 
               0.905                0.005 

Loadings:
                     Factor1 Factor2 Factor3 Factor4
fixed.acidity         0.438  -0.521   0.628   0.203 
volatile.acidity      0.123   0.328  -0.202  -0.218 
citric.acid           0.162  -0.430   0.499   0.373 
residual.sugar        0.185   0.325   0.379   0.125 
chlorides             0.245                         
free.sulfur.dioxide           0.451  -0.104   0.575 
total.sulfur.dioxide  0.160   0.467  -0.148   0.750 
density               0.871           0.486         
pH                   -0.329   0.632  -0.168  -0.439 
sulphates                             0.245   0.167 
alcohol              -0.856           0.512         

               Factor1 Factor2 Factor3 Factor4
SS loadings      1.954   1.506   1.448   1.369
Proportion Var   0.178   0.137   0.132   0.124
Cumulative Var   0.178   0.315   0.446   0.571

Test of the hypothesis that 4 factors are sufficient.
The chi square statistic is 1458.43 on 17 degrees of freedom.
The p-value is 4.32e-300 
#fatorial1$loadings
load = fatorial1$loadings[,c(1,2)]
plot(load, type="n")
text(load, labels=names(dados.pad),cex = .7)#visualiza variaveis com fatores

fa.diagram(fatorial1$loadings, digits = 3, main = "Análise Fatorial")

A partir do diagrama com as cargas fatoriais é possível observar que as variáveis cloreto e sulfatos têm pouco peso na composição dos fatores. Assim, pode-se excluir tais variáveis do modelo.

dados2 <- subset(dados, select = -c(sulphates, chlorides))

dados2.pad <- as.data.frame(scale(dados2))

fatorial2<- factanal(dados2.pad, factors=4, rotation="none", na.action=na.omit)

fatorial2

Call:
factanal(x = dados2.pad, factors = 4, na.action = na.omit, rotation = "none")

Uniquenesses:
       fixed.acidity     volatile.acidity          citric.acid 
               0.077                0.804                0.423 
      residual.sugar  free.sulfur.dioxide total.sulfur.dioxide 
               0.699                0.486                0.114 
             density                   pH              alcohol 
               0.005                0.295                0.005 

Loadings:
                     Factor1 Factor2 Factor3 Factor4
fixed.acidity         0.442  -0.320   0.634   0.472 
volatile.acidity      0.121   0.156  -0.205  -0.339 
citric.acid           0.164  -0.140   0.502   0.527 
residual.sugar        0.186   0.341   0.374  -0.102 
free.sulfur.dioxide           0.672  -0.109   0.223 
total.sulfur.dioxide  0.160   0.831  -0.155   0.381 
density               0.872           0.482         
pH                   -0.331   0.274  -0.174  -0.700 
alcohol              -0.854           0.515         

               Factor1 Factor2 Factor3 Factor4
SS loadings      1.898   1.481   1.400   1.313
Proportion Var   0.211   0.165   0.156   0.146
Cumulative Var   0.211   0.375   0.531   0.677

Test of the hypothesis that 4 factors are sufficient.
The chi square statistic is 734.47 on 6 degrees of freedom.
The p-value is 2.2e-155 

Rotação de Fatores

Sabe-se que vetores característicos não são únicos e, por isso, as cargas fatoriais da Análise Fatorial por Componentes Principais podem ser modificadas sem prejudicar o significado da análise. A rotação consiste em “modificar” as cargas fatoriais, ou seja, calcular nova matriz A. O objetivo é obter uma matriz de cargas fatoriais de mais fácil interpretação, onde cada fator se relaciona mais distintamente com certo grupo de variáveis.

No entanto, nem sempre se tem uma estrutura nítida de relacionamento de variáveis e fatores. Normalmente, todas as variáveis apresentam coeficiente de correlação de certa magnitude com todos os fatores e, muitas vezes, é difícil identificar a relação de forma adequada. A rotação de fatores/eixos é um procedimento matematicamente correto e tem como finalidade facilitar a interpretação dos fatores, isto é, gerar uma nova solução para as cargas fatoriais que mostra uma relação mais nítida entre variáveis e fatores.

A rotação dos fatores consiste na rotação dos eixos coordenados e o cálculo de novos valores de abscissas e ordenadas relacionados com o novo sistema de eixos. Se o ângulo do novo sistema se mantiver em 90º, a rotação é denominada ortogonal e, se mudar o ângulo, a rotação é denominada oblíqua. No primeiro caso os fatores permanecem não correlacionados, mas, no segundo caso, haverá correlação, o que dificulta a interpretação.

Vale ressaltar que a rotação ortogonal modifica as cargas fatoriais, mas não modifica as comunalidades (\(h_i^2\)) e, como observa Mingoti (2005, p. 121), “em termos de qualidade de ajuste, esta nova solução não acrescenta nenhuma melhoria em relação ao ajuste obtido usando a matriz \(\hat A_{p_xm}\), pois a matriz residual original não é alterada pela transformação ortogonal”.

Existem diversos métodos de rotação, tanto ortogonal (Varimax, Quartimax, Orthomax, Equimax) quanto oblíqua (Oblimim, Quartimim, Biquartimim, Covax). Entretanto, o método de rotação mais utilizado é o Varimax, o qual permite que os coeficientes de correlação entre os indicadores e os fatores fiquem o mais próximo possível de zero ou de 1 em valor absoluto, facilitando a interpretação.

O método de Rotação Varimax “forma um novo sistema de eixos ortogonais com o mesmo número de fatores e permite que o grupo de variáveis apareça com maior nitidez, facilitando a interpretação e análise” (ZAMBRANO e LIMA, 2004).

Considere que partindo da já vista matriz de correlaçoes

\[ \mathbf{\Sigma} = AA'+\Psi \] se tenha uma matriz ortogonal T de tal forma que \(TT'=I\). Então, é possível escrever

\[ \mathbf{\Sigma} = ATT'A'+\Psi \]

\[ \mathbf{\Sigma} = AT(AT)'+\Psi \]

se denominar AT por A*, tem-se

\[ \mathbf{\Sigma} = A^{*} A^{* '}+ \Psi \] isto significa que dada uma solução para A, é possível encontrar uma outra solução para \(A^*\), através da escolha da matriz ortogonal T, que seja de mais fácil interpretação do que a solução original.

No critério Varimax, a busca pela matriz T tem como base a tentativa de encontrar fatores com grandes variabilidades nas cargas fatoriais, isto é, encontrar para um fator fixo, um grupo de variáveis X altamente correlacionadas com o fator e um outro grupo de variáveis que tenham correlação desprezível ou moderada com o fator.

Para cada fator fixo, a solução é obtida através da maximização da variação dos quadrados das cargas fatoriais originais das colunas da matriz A. Seja \(\hat a_{ij}^*\) o coeficiente da i-ésima variável no j-ésimo fator após a rotação, e seja V a quantidade definida por

\[ V= \frac{1}{p} \sum_{j=1}^m \Bigg[\sum_{i=1}^p \tilde a_{ij}^4-\frac{1}{p}(\sum_{i=1}^p \tilde a_{ij}^2)^2 \Bigg] \]

onde \(\tilde a_{ij}=(\hat a_{ij}^*/ \hat h_i)\), sendo \(\hat h_i\) a raiz quadrada da comunalidade da variável \(X_i\). A maximização de V corresponde a “puxar” os quadrados das cargas sobre cada fator o máximo possível. O que se espera é encontrar grupos definidos de coeficientes para cada coluna de fator.

A função da rotação de fatores tem a função de procurar cargas fatoriais que mostram um padrão de relacionamento claro e de fácil interpretação entre variáveis e fatores. Deve-se observar que as comunalidades não mudam, o que é uma característica da rotação ortogonal.

#Esimação da AF fazendo a rotação Varimax
fatorial3<- factanal(dados2.pad, factors=4, rotation="varimax", na.action=na.omit)

fatorial3

Call:
factanal(x = dados2.pad, factors = 4, na.action = na.omit, rotation = "varimax")

Uniquenesses:
       fixed.acidity     volatile.acidity          citric.acid 
               0.077                0.804                0.423 
      residual.sugar  free.sulfur.dioxide total.sulfur.dioxide 
               0.699                0.486                0.114 
             density                   pH              alcohol 
               0.005                0.295                0.005 

Loadings:
                     Factor1 Factor2 Factor3 Factor4
fixed.acidity         0.843  -0.191  -0.110   0.404 
volatile.acidity     -0.395          -0.180         
citric.acid           0.725                   0.212 
residual.sugar                0.186           0.510 
free.sulfur.dioxide           0.709                 
total.sulfur.dioxide          0.929  -0.113   0.102 
density               0.329          -0.500   0.794 
pH                   -0.801           0.244         
alcohol                               0.991         

               Factor1 Factor2 Factor3 Factor4
SS loadings      2.150   1.454   1.362   1.126
Proportion Var   0.239   0.162   0.151   0.125
Cumulative Var   0.239   0.401   0.552   0.677

Test of the hypothesis that 4 factors are sufficient.
The chi square statistic is 734.47 on 6 degrees of freedom.
The p-value is 2.2e-155 
fa.diagram(fatorial3$loadings, digits = 3, main = "Análise Fatorial - Modelo Rotacionado Varimax")

#Comunalidades
rowSums(fatorial3$loadings^2)
       fixed.acidity     volatile.acidity          citric.acid 
           0.9225403            0.1960390            0.5772663 
      residual.sugar  free.sulfur.dioxide total.sulfur.dioxide 
           0.3010489            0.5139767            0.8859532 
             density                   pH              alcohol 
           0.9950187            0.7054388            0.9950052 
# Matriz Residual
L <- fatorial3$loadings

rho_til <- L%*%t(L)+diag(fatorial3$uniquenesses)
U <- cor(dados2.pad) - rho_til
round(U, 4)
                     fixed.acidity volatile.acidity citric.acid residual.sugar
fixed.acidity               0.0000           0.0303     -0.0135        -0.0474
volatile.acidity            0.0303           0.0000     -0.2687        -0.0315
citric.acid                -0.0135          -0.2687      0.0000         0.0267
residual.sugar             -0.0474          -0.0315      0.0267         0.0000
free.sulfur.dioxide         0.0131          -0.0657     -0.0337         0.0163
total.sulfur.dioxide        0.0000           0.0243      0.0029        -0.0136
density                     0.0002           0.0000      0.0005         0.0017
pH                         -0.0079          -0.0407      0.0079        -0.1237
alcohol                     0.0002           0.0008     -0.0002         0.0009
                     free.sulfur.dioxide total.sulfur.dioxide density      pH
fixed.acidity                     0.0131               0.0000  0.0002 -0.0079
volatile.acidity                 -0.0657               0.0243  0.0000 -0.0407
citric.acid                      -0.0337               0.0029  0.0005  0.0079
residual.sugar                    0.0163              -0.0136  0.0017 -0.1237
free.sulfur.dioxide               0.0000               0.0029 -0.0004  0.0321
total.sulfur.dioxide              0.0029               0.0000  0.0000 -0.0015
density                          -0.0004               0.0000  0.0000  0.0008
pH                                0.0321              -0.0015  0.0008  0.0000
alcohol                          -0.0003               0.0001  0.0000  0.0004
                     alcohol
fixed.acidity          2e-04
volatile.acidity       8e-04
citric.acid           -2e-04
residual.sugar         9e-04
free.sulfur.dioxide   -3e-04
total.sulfur.dioxide   1e-04
density                0e+00
pH                     4e-04
alcohol                0e+00

Para esse último modelo, o fator 1 está fortemente relacionado à acidez e Ph. O fator 2 ao dióxido de enxofre, o fator 3 é composto pela quantidade de alcool e o fator 4 pela densidade e açucar residual.

A partir das comunalidades é possível concluir que os 4 fatores explicam cerca de 92% da variabilidade da acidez fixa, pouco mais de 19% da variabilidade da acidez volátil, 57% da variabilidade da acidez cítrica, 30% da variabilidade do açucar residual, 51% da variabilidade do enxofre livre, 88% da variação no enxofre total, 99% da variação na densidade, 70% na variação do Ph e 99% da variabilidade do teor alcólico.

A análise da matriz residual indica a qualidade do modelo, que deve possuir uma matriz residual com valores muito próximos a zero. Assim, a partir desta matriz residual, o modelo em questão indica que a Análise Fatorial se ajusta bem aos dados amostrais, pois a grande maioria dos valores da matriz foram calculados proximos a zero.

Escores Fatoriais

Escores fatoriais são os valores de cada fator para cada observação da amostra. São importantes para mapeamento das observações e para serem utilizadas em outras técnicas, como cluster, regressão, etc. Como se tem um modelo estatístico estes escores devem ser estimados à semelhança de um modelo de regressão onde se obtém previsões para a variável dependente.

#Esimação da AF fazendo a rotação Varimax
fatorial3<- factanal(dados2.pad, factors=4, rotation="varimax", na.action=na.omit, scores = "regression")

escores <- as.data.frame(fatorial3$scores)

head(escores)
tail(escores)
ggplot(data = escores, mapping = aes(x = Factor1, y = Factor2)) +
geom_point() +
labs(x = "Fator 1",
y = "Fator 2",
title = "Dispersão dos escores fatoriais") +
theme_bw()

Análise da Adequabilidade

  1. Matriz de Correlações: examinar a matriz de correlações simples, procurando visualizar algum padrão de relacionamento entre as variáveis; devem existir grupos de variáveis correlacionadas;

  2. Matriz Anti-Imagem: Matriz de correlações Parciais com sinais invertidos. Matrizes anti-imagem podem ser usadas para avaliar se variáveis individuais devem ser incluídas na análise fatorial. Isso significa trazer a porção de variância de uma variável que pode ser explicada com as variáveis correlacionadas (imagem) em associação com a porção de variância inexplicável (anti-imagem). As variáveis são adequadas para incluir na análise fatorial se os valores da matriz anti-imagem forem baixos;

  3. Teste de esfericidade de Bartlett: testa se a matriz de correlações é estatisticamente igual a uma matriz identidade. Se for, não é boa para Análise Fatorial. O que se busca, então, é rejeitar a hipótese nula de que a matriz de correlação verdadeira é uma matriz identidade;

  4. Medida KMO (Kayser-Meyer-Olkin): é um índice que compara correlações simples e parciais:

\[ \mathbf{KMO}=\frac{\sum_{i=1}^{p}\sum_{j=1}^{p}r_{ij}^2}{\sum_{i=1}^{p}\sum_{j=1}^{p}r_{ij}^2+\sum_{i=1}^{p}\sum_{j=1}^{p}a_{ij}^2} \] em que \(r_{ij}\) é o coeficiente de correlação simples e \(a_{ij}\) é a correlação parcial.

Quanto mais \(\sum_{i=1}^{p}\sum_{j=1}^{p}a_{ij}^2\) for próximo de 0, mais o valor de \(\mathbf{KMO}\) se aproximará de 1 e mais adequados os dados serão para a Análise fatorial. Valores abaixo de 0,6 são considerados ruins para a Análise Fatorial.

#Correlaçoes Parciais - Matriz anti-imagem coeficientes de corr
partial.cor <- function (X, ...)
{
  R <- cor(X, ...)
  RI <- solve(R)
  D <- 1/sqrt(diag(RI))
  Rp <- -RI * (D %o% D)
  diag(Rp) <- 0
  rownames(Rp) <- colnames(Rp) <- colnames(X)
  Rp
}
matcorp <- partial.cor(dados)
print(matcorp, digits=2)
                     fixed.acidity volatile.acidity citric.acid residual.sugar
fixed.acidity                 0.00            0.050      0.3333         -0.431
volatile.acidity              0.05            0.000     -0.5355         -0.024
citric.acid                   0.33           -0.535      0.0000          0.053
residual.sugar               -0.43           -0.024      0.0534          0.000
chlorides                    -0.23            0.264      0.2637         -0.011
free.sulfur.dioxide           0.11           -0.165     -0.1625          0.126
total.sulfur.dioxide         -0.23            0.214      0.2650          0.036
density                       0.79            0.128      0.0086          0.595
pH                           -0.72            0.027     -0.0342         -0.329
sulphates                    -0.15           -0.209      0.0266         -0.201
alcohol                       0.54            0.079      0.1495          0.502
                     chlorides free.sulfur.dioxide total.sulfur.dioxide density
fixed.acidity           -0.233               0.110               -0.232  0.7854
volatile.acidity         0.264              -0.165                0.214  0.1284
citric.acid              0.264              -0.162                0.265  0.0086
residual.sugar          -0.011               0.126                0.036  0.5952
chlorides                0.000               0.059               -0.140  0.0938
free.sulfur.dioxide      0.059               0.000                0.663 -0.0854
total.sulfur.dioxide    -0.140               0.663                0.000  0.0788
density                  0.094              -0.085                0.079  0.0000
pH                      -0.231               0.138               -0.194  0.5722
sulphates                0.351               0.054                0.033  0.2480
alcohol                 -0.092              -0.026               -0.083 -0.7558
                         pH sulphates alcohol
fixed.acidity        -0.719    -0.152   0.543
volatile.acidity      0.027    -0.209   0.079
citric.acid          -0.034     0.027   0.149
residual.sugar       -0.329    -0.201   0.502
chlorides            -0.231     0.351  -0.092
free.sulfur.dioxide   0.138     0.054  -0.026
total.sulfur.dioxide -0.194     0.033  -0.083
density               0.572     0.248  -0.756
pH                    0.000    -0.129   0.520
sulphates            -0.129     0.000   0.289
alcohol               0.520     0.289   0.000
#Estatística KMO
KMO(cor(dados))
Kaiser-Meyer-Olkin factor adequacy
Call: KMO(r = cor(dados))
Overall MSA =  0.43
MSA for each item = 
       fixed.acidity     volatile.acidity          citric.acid 
                0.45                 0.52                 0.70 
      residual.sugar            chlorides  free.sulfur.dioxide 
                0.21                 0.46                 0.48 
total.sulfur.dioxide              density                   pH 
                0.45                 0.37                 0.45 
           sulphates              alcohol 
                0.51                 0.23 
# Bartlett teste de esfericidade
cortest.bartlett(cor(dados), n = nrow(dados))
$chisq
[1] 8017.566

$p.value
[1] 0

$df
[1] 55
bart_spher(dados)
    Bartlett's Test of Sphericity

Call: bart_spher(x = dados)

     X2 = 8017.566
     df = 55
p-value < 2.22e-16

Um outro exemplo é do trabalho que visou construiu um Índice de Desenvolvimento Humano da mesorregião do Campo das Vertentes-MG (IDF-CV), para o ano de 2000, com base em 10 indicadores socioeconômicos de saúde, infraestrutura, educação e vulnerabilidade renda (Esperança de vida ao nascer; Mortalidade até um ano de idade; em cada mil crianças nascidas vivas; Percentual de pessoas que vivem em domicílios com banheiro e água encanada; Percentual de pessoas que vivem em domicílios com energia elétrica e geladeira; Percentual de pessoas que vivem em domicílios urbanos com serviço de coleta de lixo; Percentual de pessoas que vivem em domicílios com carro, computador e TV; Percentual da renda proveniente de transferências governamentais; Razão entre a renda média dos 20% mais ricos e a dos 40% mais pobres; Percentual de pessoas que vivem em famílias com razão de dependência maior que 75%; Taxa de alfabetização). Para isto, foi utilizada a técnica da Análise Fatorial.

#Direcionado o R para o Diretorio a ser trabalhado
setwd('/Users/jricardofl/Dropbox/tempecon/multivariada')

library(tidyverse)
library(skimr)
library(psych)
library(REdaS)

#Lendo os dados no R
dadosc <- read.csv2('idh_mg.csv', header=TRUE, sep=";", dec=".")

dados <- dadosc[,-1]
  
attach(dados)
glimpse(dados)
Rows: 36
Columns: 10
$ esp          <dbl> 70.50, 70.93, 72.47, 69.23, 70.06, 70.18, 72.47, 70.68, 6…
$ mort         <dbl> 27.17, 25.92, 21.67, 31.06, 28.49, 28.12, 21.67, 26.66, 4…
$ banho        <dbl> 93.83, 86.76, 96.40, 95.08, 86.22, 74.52, 92.80, 89.01, 8…
$ energia      <dbl> 75.88, 72.66, 88.31, 77.68, 55.28, 54.61, 73.26, 78.20, 6…
$ lixo         <dbl> 84.64, 94.26, 95.39, 92.41, 87.94, 79.43, 76.71, 96.06, 8…
$ rend_transf  <dbl> 18.93, 19.73, 20.92, 24.67, 25.38, 23.27, 24.85, 18.07, 2…
$ X20_40pobres <dbl> 9.53, 9.74, 13.73, 12.19, 6.80, 9.16, 11.94, 14.60, 7.10,…
$ alfabet      <dbl> 84.07, 84.50, 91.47, 91.44, 85.59, 85.28, 90.08, 87.84, 8…
$ ant_3        <dbl> 33.06, 32.33, 58.16, 34.94, 20.72, 24.56, 33.74, 31.10, 2…
$ dep_75       <dbl> 34.68, 36.62, 33.82, 35.42, 35.33, 40.13, 36.45, 42.85, 3…
head(dados)
tail(dados)
# Estatística descritiva das variáveis
summary(dados)
      esp             mort           banho          energia     
 Min.   :65.34   Min.   :16.43   Min.   :74.52   Min.   :47.10  
 1st Qu.:69.14   1st Qu.:25.36   1st Qu.:85.75   1st Qu.:63.50  
 Median :70.68   Median :26.66   Median :90.58   Median :73.72  
 Mean   :70.22   Mean   :28.32   Mean   :89.46   Mean   :73.07  
 3rd Qu.:71.13   3rd Qu.:31.33   3rd Qu.:93.75   3rd Qu.:82.09  
 Max.   :74.58   Max.   :44.67   Max.   :99.39   Max.   :94.07  
      lixo        rend_transf     X20_40pobres       alfabet     
 Min.   :73.17   Min.   :12.46   Min.   : 6.270   Min.   :76.54  
 1st Qu.:83.63   1st Qu.:18.82   1st Qu.: 8.615   1st Qu.:85.27  
 Median :88.75   Median :20.61   Median :11.350   Median :88.41  
 Mean   :88.45   Mean   :20.59   Mean   :11.111   Mean   :87.49  
 3rd Qu.:93.67   3rd Qu.:22.55   3rd Qu.:12.480   3rd Qu.:90.69  
 Max.   :97.14   Max.   :26.39   Max.   :18.670   Max.   :94.01  
     ant_3           dep_75     
 Min.   :19.87   Min.   :32.66  
 1st Qu.:25.57   1st Qu.:35.55  
 Median :31.25   Median :36.82  
 Mean   :32.13   Mean   :36.76  
 3rd Qu.:35.07   3rd Qu.:37.74  
 Max.   :58.16   Max.   :42.85  
skim(dados)
Data summary
Name dados
Number of rows 36
Number of columns 10
_______________________
Column type frequency:
numeric 10
________________________
Group variables None

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
esp 0 1 70.22 1.96 65.34 69.14 70.68 71.13 74.58 ▂▂▇▆▁
mort 0 1 28.32 6.07 16.43 25.36 26.66 31.33 44.67 ▃▇▃▂▂
banho 0 1 89.46 5.56 74.52 85.76 90.58 93.75 99.39 ▁▅▆▇▅
energia 0 1 73.07 12.52 47.10 63.50 73.72 82.09 94.07 ▃▃▆▇▅
lixo 0 1 88.45 6.55 73.17 83.63 88.75 93.67 97.14 ▁▃▃▃▇
rend_transf 0 1 20.59 3.01 12.46 18.82 20.60 22.55 26.39 ▁▂▇▅▃
X20_40pobres 0 1 11.11 3.04 6.27 8.62 11.35 12.48 18.67 ▆▃▇▃▁
alfabet 0 1 87.49 4.30 76.54 85.27 88.41 90.69 94.01 ▂▂▅▇▆
ant_3 0 1 32.13 9.33 19.87 25.56 31.25 35.07 58.16 ▆▇▂▂▁
dep_75 0 1 36.76 2.16 32.66 35.55 36.82 37.74 42.85 ▃▆▇▂▁
#Estatística KMO
KMO(cor(dados))
Kaiser-Meyer-Olkin factor adequacy
Call: KMO(r = cor(dados))
Overall MSA =  0.7
MSA for each item = 
         esp         mort        banho      energia         lixo  rend_transf 
        0.67         0.67         0.73         0.73         0.87         0.51 
X20_40pobres      alfabet        ant_3       dep_75 
        0.24         0.85         0.74         0.58 
# Bartlett teste de esfericidade
cortest.bartlett(cor(dados), n = nrow(dados))
$chisq
[1] 332.1296

$p.value
[1] 1.984378e-45

$df
[1] 45
bart_spher(dados)
    Bartlett's Test of Sphericity

Call: bart_spher(x = dados)

     X2 = 332.13
     df = 45
p-value < 2.22e-16
#Correlaçoes Parciais - Matriz anti-imagem coeficientes de corr
partial.cor <- function (X, ...)
{
  R <- cor(X, ...)
  RI <- solve(R)
  D <- 1/sqrt(diag(RI))
  Rp <- -RI * (D %o% D)
  diag(Rp) <- 0
  rownames(Rp) <- colnames(Rp) <- colnames(X)
  Rp
}
matcorp <- partial.cor(dados)
print(matcorp, digits=2)
                esp   mort  banho energia   lixo rend_transf X20_40pobres
esp           0.000 -0.996  0.053   0.075 -0.114       0.158        0.074
mort         -0.996  0.000  0.065   0.072 -0.118       0.165        0.059
banho         0.053  0.065  0.000   0.506  0.293       0.351        0.254
energia       0.075  0.072  0.506   0.000  0.141      -0.380       -0.404
lixo         -0.114 -0.118  0.293   0.141  0.000      -0.351        0.017
rend_transf   0.158  0.165  0.351  -0.380 -0.351       0.000       -0.236
X20_40pobres  0.074  0.059  0.254  -0.404  0.017      -0.236        0.000
alfabet      -0.105 -0.116  0.117   0.124  0.068       0.116       -0.423
ant_3         0.121  0.101 -0.234   0.670  0.027       0.196        0.484
dep_75       -0.087 -0.072 -0.197   0.156  0.097      -0.073        0.336
             alfabet  ant_3 dep_75
esp           -0.105  0.121 -0.087
mort          -0.116  0.101 -0.072
banho          0.117 -0.234 -0.197
energia        0.124  0.670  0.156
lixo           0.068  0.027  0.097
rend_transf    0.116  0.196 -0.073
X20_40pobres  -0.423  0.484  0.336
alfabet        0.000  0.299  0.199
ant_3          0.299  0.000 -0.317
dep_75         0.199 -0.317  0.000
# Definição do número de Fatores

eigv <- eigen(cor(dados))
eigv <- data.frame(nfact = 1:ncol(dados), eigval = eigv$values)
ggplot(data = eigv, mapping = aes(nfact, eigval)) +
geom_line() +
geom_point() +
geom_abline(slope = 0, intercept = 1, color = "red") +
labs(x = "Número de fatores",
y = "Autovalor",
title = "Scree plot") +
theme_bw()

#Padronizaçao dos dados
dados.pad <-as.data.frame(scale(dados))

s <- cov(dados.pad) #matriz de cov com var pad = mat correlaçoes origem

#Autovalores e Autovetores da Matriz de Covariancias
lambda <-eigen(s)$values
lambda[1:3] 
[1] 4.628794 1.587772 1.339147
evec <-eigen(s)$vectors
evec[,1:3]
             [,1]        [,2]        [,3]
 [1,]  0.34885131 -0.28329574  0.42235518
 [2,] -0.34625878  0.29228336 -0.41385695
 [3,]  0.33160581  0.23849914 -0.19934006
 [4,]  0.42552524  0.10846951 -0.18012801
 [5,]  0.33869887 -0.08357043 -0.40080608
 [6,] -0.15904596  0.45277917  0.40583177
 [7,] -0.03376863 -0.60774320  0.06261031
 [8,]  0.36046960  0.27352317 -0.11576985
 [9,]  0.41521607  0.01176567  0.05227321
[10,] -0.15452481 -0.33070885 -0.48244774